;;;; theater.lisp

;;; The Theater and Stage.

(in-package :xlui)

(defclass theater (animated-application-window)
  ())

;;;; ---- ;;;;

(defclass stage (agent-3d-view)
  ((space :accessor space :initarg :space :initform (make-instance 'cp:space))))

(defmethod animate ((view stage) time)
  (cp:step-simulation (space view)))

(defmethod texture-file ((view stage) texture-name)
  (native-path "dt:data;" texture-name))

(defmethod use-texture ((view stage) texture-name)
  (let ((texture (gethash texture-name (textures view))))
    ;; load texture from file if necessary
    (unless texture
      (setq texture (make-instance 'gl:texture-arb 
                      :source (texture-file view texture-name) :glview view))
      (setf (gethash texture-name (textures view)) texture))
    ;; make the texture active (for now assume a 2D texture)
    (when Texture
      (glBindTexture GL_TEXTURE_RECTANGLE_ARB (gl:binding texture))
      texture)))

(defmethod use-texture-from-grid ((view stage) texture-grid texture-name)
  (let ((tgrid (gethash texture-grid (textures view))))
    ;; load texture from file if necessary
    (unless tgrid
      (setq tgrid (gl::make-texture-grid-from-spec-file (texture-file view texture-grid) view))
      (setf (gethash texture-grid (textures view)) tgrid))
    ;; make the texture active (for now assume a 2D texture)
    (when tgrid
      (let ((spec (gethash texture-name (gl::texture-grid-names tgrid))))
	(glBindTexture GL_TEXTURE_RECTANGLE_ARB (gl:binding tgrid))
	(values-list spec)))))

(defparameter *default-pan-gain* 0.1)

(defun calc-delta-coord (view x y dx dy)
  (multiple-value-bind (x1 y1 z1) (gl::window-to-gl-coord view x y t)
    (declare (ignore z1))
    (multiple-value-bind (x2 y2 z2) (gl::window-to-gl-coord view (+ x dx) (+ y dy) t)
      (declare (ignore z2))
      (values (- x2 x1) (- y2 y1)))))

#|
  (let ((agent (first (agents-selected view))))
    (if agent
	(multiple-value-bind (gl-x gl-y) (calc-delta-coord view x y dx dy)
	  (let ((scale (coerce (lui::eye-z (lui::camera view)) 'single-float)))
	    (incf (x agent) (* gl-x scale))
	    (incf (y agent) (* gl-y scale))))
	(progn
	  (cond ((alt-key-p) (track-mouse-zoom (camera view) dx dy (if (shift-key-p) 0.005 0.2)))
		(t (track-mouse-pan (camera view) dx dy (if (shift-key-p) 0.01 0.05))))))
    (unless (lui::is-animated view) (display view))))
|#

(defmethod lui::view-left-mouse-dragged-event-handler ((view stage) x y dx dy)
  (cond ((alt-key-p) (track-mouse-zoom (camera view) dx dy (if (shift-key-p) 0.005 0.2)))
        (t (track-mouse-pan (camera view) dx dy (if (shift-key-p) 0.01 0.05))))
  (unless (lui::is-animated view) (display view)))

(defmethod clear-background ((stage stage))
  ;; don't do this for transparent windows
  (glClearColor 0.0 0.0 0.0 0.0)
  (glClear #.(logior GL_COLOR_BUFFER_BIT GL_STENCIL_BUFFER_BIT))); GL_DEPTH_BUFFER_BIT)))

(defmethod init ((view stage))
  ;; Synchronize buffer swaps with vertical refresh rate
  (ccl:rlet ((swap-int #>GLuint 1))
    (#/setValues:forParameter: (#/openGLContext (lui::native-view view)) swap-int #$NSOpenGLCPSwapInterval))

  ;; GL setup
  ;; Alpha

  (glEnable gl_blend)			;
  (glblendfunc gl_one gl_one_minus_src_alpha)
  (glenable gl_alpha_test)

  ;; camera
  (aim-camera (camera view) :eye-z 10.0 :near 1.0)
  ;; compose the scene
  ;(gldisable GL_DEPTH_TEST)
  ;;(compose-scene Self)
  )

;;;; ---- ;;;;

(defparameter *debug-cp-shape* nil)

(defclass gelement (agent-3d) ;; G is for "Game!"
  ())

(defmethod draw-bounding-box ((Self gelement) Red Green Blue &optional (Alpha 1.0))
  (let* ((Dx (bounding-box-width Self))
         (Dy (bounding-box-height Self))
         (S (* 0.07 (min dx dy))))
    (glDisable GL_LIGHTING)
    (glDisable GL_TEXTURE_RECTANGLE_ARB)
    ;; color and width
    (glColor4f Red Green Blue Alpha)
    (glLineWidth 3.0)
    (glBegin GL_LINES)
    (dotimes (I 2)
      (dotimes (J 2)
	(let ((X (- (if (= i 0) (- s) (+ (* i dx) s)) (/ dx 2.0)))
	      (Y (- (if (= j 0) (- s) (+ (* j dy) s)) (/ dy 2.0))))
	  (glVertex2f x y)
	  (glVertex2f (if (= i 0) (+ x s) (- (/ dx 2.0) s)) y)
	  (glVertex2f x y)
	  (glVertex2f x (if (= j 0) (+ y s) (- (/ dy 2.0) s))))))
    (glEnd)
    (glColor3f 1.0 1.0 1.0)
    (glEnable GL_LIGHTING)))

(defclass sprite (gelement)
  ((width :accessor width :initarg :width :type short-float)
   (height :accessor height :initarg :height :type short-float)
   (texture :accessor texture :initarg :texture :initform "name of file with texture data.")
   (texture-grid :accessor texture-grid :initarg :texture-grid :initform nil)))

(defmethod bounding-box-width ((self sprite))
  (width Self))

(defmethod bounding-box-height ((self sprite))
  (height Self))

(defmethod bounding-box-depth ((self sprite))
  0.0)

(defmethod element-in-sprite-p ((e gelement) (b sprite))
  (with-slots (x y) e
    (let* ((ox (x b))
           (oy (y b))
           (ex (+ ox (width b)))
           (ey (+ oy (width b))))
      (and (> x ox) (> y oy)
           (< x ex) (< y ey)))))

#.(gl:enable-gl-type-syntax)

(defun gl-vertex (gl-vec)
  (glVertex3fv (gl:get-pointer gl-vec)))

(defun draw-sprite-box (iwidth iheight twidth theight &optional (torigin-x 0.0) (torigin-y 0.0))
  "Assumes the GLContext has been set!"
  (let* ((iw (* iwidth 0.5))
	 (ih (* iheight 0.5))
	 (v0 (gl:%gl-vector iw     ih     0.0))
	 (v1 (gl:%gl-vector (- iw) ih     0.0))
	 (v2 (gl:%gl-vector (- iw) (- ih) 0.0))
	 (v3 (gl:%gl-vector iw     (- ih) 0.0)))
    (glcolor4f 1.0 1.0 1.0 1.0)
    (gl:with-gl #$GL_QUADS
      ;; Front Face
      (glNormal3f 0.0 0.0 1.0)
      (glTexCoord2f torigin-x torigin-y)         (gl-vertex v0)
      (glTexCoord2f twidth torigin-y)      (gl-vertex v1)
      (glTexCoord2f twidth theight)  (gl-vertex v2)
      (glTexCoord2f torigin-x theight)     (gl-vertex v3))))

(defmethod draw ((agent sprite))
  (glEnable GL_TEXTURE_RECTANGLE_ARB)
  (gltexenvi gl_texture_env gl_texture_env_mode gl_replace)
  (with-slots (width height texture texture-grid) agent
    (if texture-grid
	(multiple-value-bind (ox oy ex ey) (use-texture-from-grid (view agent) texture-grid texture)
	  (draw-sprite-box width height ex ey ox oy))
	(let ((tex (use-texture (view agent) (texture agent))))
	  (draw-sprite-box width height (gl:texture-width tex) (gl:texture-height tex)))))
  (gldisable GL_TEXTURE_RECTANGLE_ARB)
  (call-next-method))

(defclass terrain (sprite)
  ((class :accessor terrain-class :initarg :class)
   (move-modifier :accessor move-modifier :initarg :move-modifier)
   (cover-modifier :accessor cover-modifier :initarg :cover-modifier)
   (layer :accessor terrain-layer :initarg :layer)))


;;;; ---- ;;;;

(defclass physical (sprite)
  ((cp-shape :accessor shape :initform nil)
   (static :accessor static :initarg :static :type boolean :initform nil))
  (:default-initargs
      :z 0.0))

(defmethod mouse-hover-enter-event-handler ((agent physical))
  (log5:log-for (trace) "Mouse is hovering over agent ~A." agent))

(defmethod draw :after ((agent physical))
  (when *debug-cp-shape*
    (glcolor3f 1.0 1.0 1.0)
    (cp:draw-shape (shape agent))))

(defmethod attach :after ((view stage) (agent physical))
  (with-slots (cp-shape static) agent
    (with-slots (space) view
      (if static
	  (progn (cp:add-static-object space (cp:body cp-shape))
		 (cp:add-static-object space cp-shape))
	  (progn (cp:add-object space (cp:body cp-shape))
		 (cp:add-object space cp-shape))))))
 
(defmethod x ((agent physical))
  (coerce (cp:cpv.x (cp:pos (shape agent))) 'single-float))

(defmethod roll ((agent physical))
  (with-slots (cp-shape) agent
    (coerce (* (cp:angle (cp:body cp-shape))
	       (/ 180 PI))
	    'short-float)))

(defmethod (setf x) (val (agent physical))
  (setf (cp:cpv.x (cp:pos (shape agent))) (coerce val 'double-float)))

(defmethod (setf y) (val (agent physical))
  (setf (cp:cpv.y (cp:pos (shape agent))) (coerce val 'double-float)))

(defmethod y ((agent physical))
  (coerce (cp:cpv.y (cp:pos (shape agent))) 'single-float))

(defmethod z ((agent physical))
  0.0)

;;;; ==== ;;;;

(defun physical-with-texture (named texture &key (width 1.0) (height 1.0) (static nil))
  (slui (:physical :name named :width width :height height :texture texture :static static)))

(defun make-ninja-pea (&key (name (gensym "NINJA")) (pos cp:+cpvzero+) (stage nil))
  (let ((pea (physical-with-texture name "Pea-Standard.png"))
	(shape (cp:make-circle-shape 1.0d0 0.5d0 :r-inner 0.0d0 :center cp:+cpvzero+
				     :pos pos
				     :elasticity 0.6 :friction 0.2)))
    (setf (shape pea) shape)
    (when stage
      (attach stage pea))
    pea))

(defun make-standard-block (&key (name (gensym "STD_BLOCK")) (pos cp:+cpvzero+) (stage nil))
  (let ((block (physical-with-texture name "Block-Normal.png"))
        (shape (cp:make-box-shape :pos pos :elasticity 0.2 :friction 0.5)))
    (setf (shape block) shape)
    (when stage
      (attach stage block))
    block))

(defun make-ground (&key (name (gensym "GROUND")) (pos cp:+cpvzero+) (stage nil) (width 10.0) (height 1.0))
  (let* ((ground (physical-with-texture name "Plate.png" :width width :height height :static "true"))
	 (p1 pos)
	 (p2 (cp:cpv+ pos (cp:cpv width 0.0)))
	 (shape (cp:make-segment-shape p1 p2 :mass cp:+infinity+ :moment cp:+infinity+
				       :elasticity 0.7 :friction 0.5)))
    (setf (shape ground) shape)
    (when stage
      (attach stage ground))
    ground))
	

;;;; ==== ;;;;

(defun example-app ()
  (slui
   (:theater
    :title "A Window with a View." :width 640 :height 480
    (:stage :name "World"
		    (:sprite :name "Terrain Test" :x -2.5 :y 0 :width 1.0 :height 1.0 :texture "t.grassland_n1e1s1w1"
			     :texture-grid "tiles2.spec")
		    (:sprite :name "Block" :x 2.5 :y 0 :width 1.5 :height 1.0 :texture "Grass Block.png")
		    (:sprite :name "Pea" :x 0 :y 0 :width 1.0 :height 1.0 :texture "Grass Block.png")
		    (:sprite :name "Archer" :x 0 :y 0 :width 1.5 :height 1.5 :texture "archer-bow.png")))))


(defun sample-sprite ()
  (slui (:sprite :name "Terrain Test" :x -2.5 :y 0 :width 1.0 :height 1.0 :texture "t.grassland_n1e1s1w1"
		 :texture-grid "tiles2.spec")))

(defun test-texture-grid ()
  (let ((stage (sample-stage)) 
	(sprite (sample-sprite)))
    (multiple-value-bind (ox oy ex ey) (use-texture-from-grid stage (texture-grid sprite) (texture sprite))
    (format t "~A, ~A, ~A, ~A~%" ox oy ex ey))))

(defun texture-test ()
  (slui
   (:application-window
    :width 640 :height 480
    (:stage :name "World"
		    (:sprite :name "Pea" :x 0 :y 0 :width 10 :height 10 :texture "Pea-Standard.png")))))

  
(defun test-tiles ()
  (slui
   (:application-window
    :width 640 :height 480
    (:agent-3d-view :name "world"
                    (:tile :texture "Pea-Standard.png")
                    (:tile :texture "archer-bow.png")))))
